home *** CD-ROM | disk | FTP | other *** search
/ Atari Forever 4 / Atari Forever 4.zip / Atari Forever 4.iso / SERIE_S / S_902 / 3D_PLOT / 3D.GFA (.txt) < prev    next >
GFA-BASIC Atari  |  1998-03-14  |  33KB  |  1,433 lines
  1. DEFTEXT ,,,13
  2. DEFNUM 4
  3. DEFMOUSE 0
  4. ~WIND_GET(0,4,wx&,wy&,ww&,wh&)
  5. CLIP wx&,wy&,ww&,wh&
  6. '
  7. DIM menu$(48)
  8. '
  9. erstelle_menu
  10. init
  11. menu:
  12. DO
  13.   ON MENU
  14. LOOP
  15. '
  16. ' --- Menü erstellen ----------------------------------------------------------
  17. > PROCEDURE erstelle_menu
  18.   LOCAL i|
  19.   FOR i|=0 TO 46
  20.     READ menu$(i|)
  21.   NEXT i|
  22.   MENU menu$()
  23.   DATA 3D,  Über 3D,---------------------,1,2,3,4,5,6,
  24.   DATA Datei,  Funktion laden     L,  Funktion speichern S,-----------------------,  Ende               Q,
  25.   DATA Funktion,  Eingeben        E,  Wertebereich    W,--------------------,  Zeichnen        Z,  Koordinatensystem,
  26.   DATA Darstellen,  Rotation    R,  Entfernung  D,----------------,  Auflösung   A,----------------,  Durchsichtig,  Flächig,  Beleuchtet,----------------,  y-anpassen,
  27.   DATA Beleuchten,  Lichtquelle,-Schattierung-,  Winkel,  Entfernung,--------------,  Rahmen,
  28.   DATA Info,  Funktionen,  Funktionswerte,  Definitionslücken ,  Konstanten
  29.   ON MENU GOSUB was
  30.   ON MENU KEY GOSUB taste
  31. RETURN
  32. > PROCEDURE init
  33.   ' funktion speichern
  34.   LOCAL aufl_max|
  35.   aufl_max|=100
  36.   DIM f|(100)             !Speicher für die Funktion
  37.   DIM kn#(20),ko|(20)      !Keller für die Zahlen und für die Operatoren
  38.   DIM zahl#(30)            !Speicher für die Zahlen der Funktion
  39.   '  zahlp|=4             ! 0=X 1=Y 2=-X 3=-Y wird in formatiere gesetzt
  40.   DIM fun_wert#(aufl_max|,aufl_max|)   !Speicher für die Funktionswerte
  41.   DIM fun_wert.err!(aufl_max|,aufl_max|) !Fehler in der Funktionsberechnung
  42.   '
  43.   ' Projektion
  44.   DIM bx&(aufl_max|,aufl_max|)
  45.   DIM by&(aufl_max|,aufl_max|)
  46.   ' zeichnen
  47.   DIM help#(aufl_max|*(aufl_max|+1))
  48.   DIM entf.order%(aufl_max|*(aufl_max|+1))
  49.   DIM hell|(aufl_max|,aufl_max|)
  50.   ' (8+0.125+2+2+8+4+1)*101*101
  51.   '
  52.   DIM mesag&(15)
  53.   ' Textdarstellung/editieren
  54.   DIM x&(200),y&(200)
  55.   DIM text.x&(25),text.y&(25),text$(25)
  56.   DIM edit.x&(25),edit.y&(25),edit$(25)
  57.   '
  58.   ' --- Wertebereich ---
  59.   x_min#=-2
  60.   x_max#=2
  61.   y_min#=-2
  62.   y_max#=2
  63.   ' --- Auflösung ---
  64.   x_aufl|=10
  65.   y_aufl|=10
  66.   verdeckt!=FALSE
  67.   beleuchtet!=FALSE
  68.   MENU 29,1
  69.   ' --- Abstand ---
  70.   ges_abst#=10
  71.   '
  72.   stauch_y!=TRUE
  73.   MENU 33,1
  74.   ' --- Rotation ---
  75.   umz&=0
  76.   zuz&=90
  77.   neu.reihe!=TRUE
  78.   neu.projezier!=TRUE
  79.   neu.beleuchte!=TRUE
  80.   '
  81.   lich_x#=0
  82.   lich_y#=3
  83.   lich_z#=6
  84.   '
  85.   lich.winkel!=TRUE
  86.   MENU 38,1
  87.   lich.farbanz|=9               !Konstante, Anzahl der "Farben"
  88.   ' lich.entfernung!=FALSE
  89.   ' lich.rahmen!
  90.   '
  91.   ' Weitere Globale Variablen
  92.   xstep#=(x_max#-x_min#)/(x_aufl|-1)
  93.   ystep#=(y_max#-y_min#)/(y_aufl|-1)
  94.   '
  95.   cos_umz#=COS(umz&/360*2*PI)
  96.   sin_umz#=SIN(umz&/360*2*PI)
  97.   cos_zuz#=COS(zuz&/360*2*PI)
  98.   sin_zuz#=SIN(zuz&/360*2*PI)
  99.   '
  100.   x_abst#=ges_abst#*sin_umz#*sin_zuz#
  101.   y_abst#=ges_abst#*cos_umz#*sin_zuz#
  102.   z_abst#=ges_abst#*cos_zuz#
  103.   '
  104.   neu.rechne!=TRUE
  105.   '
  106.   w_xmax&=640
  107.   w_xmin&=0
  108.   w_ymax&=400
  109.   w_ymin&=20
  110.   ~WIND_GET(0,4,w_xmin&,w_ymin&,w_xmax&,w_ymax&)
  111.   ADD w_xmax&,w_xmin&-1
  112.   ADD w_ymax&,w_ymin&-1
  113.   ' verdeckt!,beleuchtet!,stauch_y!
  114. RETURN
  115. > PROCEDURE was
  116.   SELECT MENU(0)
  117.   CASE 1
  118.     ALERT 1," 3-D  Funktionsplotter |=======================| | von Matthias Jüschke",1,"Weiter",d|
  119.   CASE 11
  120.     laden
  121.   CASE 12
  122.     speichern
  123.   CASE 14
  124.     ende
  125.   CASE 17
  126.     SGET bild$
  127.     funktion.eingabe
  128.     SPUT bild$
  129.   CASE 18
  130.     SGET bild$
  131.     wertebereich
  132.     SPUT bild$
  133.   CASE 20               !Zeichnen
  134.     IF LEN(f$)
  135.       rechne
  136.       proje.all
  137.       draw
  138.     ENDIF
  139.   CASE 21
  140.     IF koord_system!=FALSE
  141.       koord_system
  142.       koord_system!=TRUE
  143.       MENU 21,1
  144.     ELSE
  145.       koord_system!=FALSE
  146.       MENU 21,0
  147.     ENDIF
  148.   CASE 24
  149.     SGET bild$
  150.     rotation
  151.     SPUT bild$
  152.   CASE 25
  153.     SGET bild$
  154.     entfernung
  155.     SPUT bild$
  156.   CASE 27
  157.     SGET bild$
  158.     aufloesung
  159.     SPUT bild$
  160.   CASE 29
  161.     verdeckt!=FALSE
  162.     beleuchtet!=FALSE
  163.     MENU 29,1
  164.     MENU 30,0
  165.     MENU 31,0
  166.   CASE 30
  167.     verdeckt!=TRUE
  168.     beleuchtet!=FALSE
  169.     MENU 29,0
  170.     MENU 30,1
  171.     MENU 31,0
  172.   CASE 31
  173.     verdeckt!=FALSE
  174.     beleuchtet!=TRUE
  175.     MENU 29,0
  176.     MENU 30,0
  177.     MENU 31,1
  178.   CASE 33
  179.     IF stauch_y!
  180.       stauch_y!=FALSE
  181.       MENU 33,0
  182.     ELSE
  183.       stauch_y!=TRUE
  184.       MENU 33,1
  185.     ENDIF
  186.     neu.projezier!=TRUE
  187.   CASE 36
  188.     SGET bild$
  189.     beleuchtung
  190.     SPUT bild$
  191.   CASE 38
  192.     IF lich.winkel! AND lich.entfernung!
  193.       lich.winkel!=FALSE
  194.       MENU 38,0
  195.     ELSE
  196.       lich.winkel!=TRUE
  197.       MENU 38,1
  198.     ENDIF
  199.     neu.beleuchte!=TRUE
  200.   CASE 39
  201.     IF lich.entfernung! AND lich.winkel!
  202.       lich.entfernung!=FALSE
  203.       MENU 39,0
  204.     ELSE
  205.       lich.entfernung!=TRUE
  206.       MENU 39,1
  207.     ENDIF
  208.     neu.beleuchte!=TRUE
  209.   CASE 41
  210.     IF lich.rahmen!
  211.       lich.rahmen!=FALSE
  212.       MENU 41,0
  213.     ELSE
  214.       lich.rahmen!=TRUE
  215.       MENU 41,1
  216.     ENDIF
  217.   CASE 44
  218.     ~FORM_ALERT(1,"[1][Funktionen:|SIN COS TAN COT|mit ~H: Hyperbolicusfunktionen|mit A~: Arcus-/Areafunktionen|SQRT LN LOG EXP ABS SGN][Weiter]")
  219.   CASE 45
  220.     werte_ausgeben(FALSE)
  221.   CASE 46
  222.     werte_ausgeben(TRUE)
  223.   ENDSELECT
  224.   MENU OFF
  225. RETURN
  226. > PROCEDURE taste
  227.   SELECT ASC(UPPER$(CHR$(MENU(14))))
  228.   CASE 76 !L
  229.     laden
  230.   CASE 83 !S
  231.     speichern
  232.   CASE 81 !Q
  233.     ende
  234.   CASE 69 !E
  235.     SGET bild$
  236.     funktion.eingabe
  237.     SPUT bild$
  238.   CASE 87 !W
  239.     SGET bild$
  240.     wertebereich
  241.     SPUT bild$
  242.   CASE 90 !Z
  243.     IF LEN(f$)
  244.       rechne
  245.       proje.all
  246.       draw
  247.     ENDIF
  248.   CASE 82 !R
  249.     SGET bild$
  250.     rotation
  251.     SPUT bild$
  252.   CASE 68 !D
  253.     SGET bild$
  254.     entfernung
  255.     SPUT bild$
  256.   CASE 65 !A
  257.     SGET bild$
  258.     aufloesung
  259.     SPUT bild$
  260.   ENDSELECT
  261. RETURN
  262. > PROCEDURE laden
  263.   FILESELECT "\*.FKT","",n$
  264.   IF EXIST(n$)
  265.     OPEN "i",#1,n$
  266.     INPUT #1,f$
  267.     CLOSE #1
  268.     IF @formatiere_f(f$,f|())<>-1
  269.       OUT 2,7
  270.       f$=""
  271.     ENDIF
  272.     neu.rechne!=TRUE
  273.     neu.projezier!=TRUE
  274.   ELSE
  275.     OUT 2,7
  276.   ENDIF
  277. RETURN
  278. > PROCEDURE speichern
  279.   FILESELECT "\*.FKT","",n$
  280.   OPEN "o",#1,n$+".FKT"
  281.   PRINT #1,f$
  282.   CLOSE #1
  283. RETURN
  284. > PROCEDURE ende
  285.   ALERT 2,"Programm|beenden ?",1,"Ja|Nein",f|
  286.   IF f|=1
  287.     MENU KILL
  288.     END
  289.   ENDIF
  290. RETURN
  291. '
  292. ' --- Funktion von f$ in ein lesbares Format in f|() bringen ------------------
  293. > FUNCTION formatiere_f(f$,VAR f|())
  294.   ' Die Prozedur formatiere_f bringt die Funktion von f$ in ein Format in
  295.   ' f|(), in dem die Funktion erg(x,y) die Ergebnisse errechnen kann. f(i)<200
  296.   ' bedeutet, daß an der Stelle i in f eine Zahl steht. Der Wert dieser
  297.   ' Zahl befindet sich in zahl(f(i)). zahl(0) bis zahl(3) steht für
  298.   ' X, Y, -X und -Y; also steht z. B. f(i)=2 für die Zahl -X.
  299.   '
  300.   ' Stehen in f(i) Werte größer 199 repräsentieren sie Funktionen.
  301.   ' ( 200 sin: 202 cos: 203 tan: 204 cot: 205
  302.   ' asin: 206 acos: 207 atan: 208 acot: 209
  303.   ' sinh210,cosh211,tanh212,atanh213
  304.   ' asinh214,acosh215,atanh216,acoth217
  305.   ' sqrt: 218 ln: 219 log: 220
  306.   ' abs: 221 sgn: 222 exp: 223
  307.   ' )201
  308.   ' Eine folgende Klammer auf wird nicht seperat gespeichert, SIN(X) führt
  309.   ' also in f() zu f(0)=202 «SIN(», f(1)=0 «X» und f(2)=201 «)».
  310.   ' Haben die Funktionen negative Vorzeichen, so wird der Wert 25 addiert.
  311.   '
  312.   ' Für die Operanten gilt die Zuordnung:
  313.   ' +250 -251 *252 /253 ^254
  314.   ' Der Wert 255 kennzeichnet das Ende der Funktion.
  315.   '
  316.   ' Die Funktion muß - wie jede Funktion - folgendermaßen aufgebaut sein:
  317.   '
  318.   ' -+->+-> Wert -+-->------------>--+--------> Ende
  319.   '  |  |         |                  |
  320.   '  |  |         +-> Klammer(n) zu -+
  321.   '  |  |                            |
  322.   '  |  +-> funktion -+              |
  323.   '  |                |              |
  324.   '  +-------------<--+<- Operator <-+
  325.   '
  326.   ' Globale Variablen werden nicht verwendet.
  327.   '
  328.   LOCAL error!,h$,kl&,fp|
  329.   zahlp|=4
  330.   h$=f$
  331.   REPEAT
  332.     IF @zahl(f$,fp|,zahlp|)
  333.       ~@klzu(f$,fp|,kl&)
  334.       error!=@oper(f$,fp|)=FALSE AND f$>""
  335.     ELSE
  336.       IF @funk(f$,fp|)
  337.         INC kl&
  338.       ELSE
  339.         error!=TRUE
  340.       ENDIF
  341.     ENDIF
  342.     error!=kl&<0 OR error!
  343.   UNTIL LEN(f$)=0 OR error!
  344.   f|(fp|)=255
  345.   INC fp|
  346.   IF error! OR kl&<>0
  347.     RETURN LEN(h$)-LEN(f$)
  348.   ENDIF
  349.   RETURN -1
  350. ENDFUNC
  351. > FUNCTION zahl(VAR f$,fp|,zahlp|)
  352.   ' Die Funktion erkennt Zahlen und X bzw. Y. Bei einer Zahl wird der Zahlen-
  353.   ' wert in zahl(j) gespeichert, und f(i) wird die Position der Zahl in zahl()
  354.   ' gespeichert, also f(i)=j
  355.   ' Bei X und Y werden die Werte automatisch in die ersten Elemente von zahl()
  356.   ' geschrieben. Diese Funktion speichert in f(i), daß an der Stelle i ein
  357.   ' X, Y, -X bzw. -Y steht.
  358.   ' f$ wird immer um den erkannten Teil gekürzt.
  359.   ' Die Funktion liefert FALSE zurück, wenn keine Zahl erkannt wurde.
  360.   LOCAL l|
  361.   '
  362.   l|=VAL?(f$)
  363.   IF l|
  364.     f|(fp|)=zahlp|    !an der stelle fp| steht die zahl zahl(zahlp|)=zahl(f(fp))
  365.     INC fp|
  366.     '
  367.     zahl#(zahlp|)=VAL(f$)
  368.     INC zahlp|
  369.     f$=RIGHT$(f$,LEN(f$)-l|)
  370.     RETURN TRUE
  371.   ENDIF
  372.   '
  373.   IF LEFT$(f$)="X"
  374.     f|(fp|)=0
  375.     INC fp|
  376.     f$=RIGHT$(f$,LEN(f$)-1)
  377.     RETURN TRUE
  378.   ELSE IF LEFT$(f$)="Y"
  379.     f|(fp|)=1
  380.     INC fp|
  381.     f$=RIGHT$(f$,LEN(f$)-1)
  382.     RETURN TRUE
  383.   ELSE IF LEFT$(f$,2)="-X"
  384.     f|(fp|)=2
  385.     INC fp|
  386.     f$=RIGHT$(f$,LEN(f$)-2)
  387.     RETURN TRUE
  388.   ELSE IF LEFT$(f$,2)="-Y"
  389.     f|(fp|)=3
  390.     INC fp|
  391.     f$=RIGHT$(f$,LEN(f$)-2)
  392.     RETURN TRUE
  393.   ENDIF
  394.   RETURN FALSE
  395. ENDFUNC
  396. > FUNCTION funk(VAR f$,fp|)
  397.   ' Diese Funktion erkennt Elementarfunktionen (mit Vorzeichen) und schreibt
  398.   ' den zu der erkannten Funktion gehörigen Wert in f(i). Der zugehörige
  399.   ' Wert wird von der Funktion wert() geliefert.
  400.   ' f$ wird immer um den erkannten Teil gekürzt.
  401.   ' Wird keine Elementarfunktion erkann, so wird FALSE zurückgeliefert.
  402.   '
  403.   LOCAL teil$,wert|,vorz!
  404.   IF ASC(f$)=ASC("-") OR ASC(f$)=ASC("+")       !Vorzeichen
  405.     vorz!=(ASC(f$)=ASC("-"))
  406.     f$=RIGHT$(f$,LEN(f$)-1)
  407.   ENDIF
  408.   WHILE LEFT$(f$)=>"A" AND LEFT$(f$)<="Z"
  409.     teil$=teil$+LEFT$(f$)
  410.     f$=RIGHT$(f$,LEN(f$)-1)
  411.   WEND
  412.   wert|=@wert(teil$)
  413.   IF wert|
  414.     IF ASC(f$)=ASC("(")
  415.       teil$=teil$+LEFT$(f$)
  416.       f$=RIGHT$(f$,LEN(f$)-1)       !"("
  417.       IF vorz!
  418.         ADD wert|,25
  419.       ENDIF
  420.       f|(fp|)=wert|
  421.       INC fp|
  422.       RETURN TRUE
  423.     ENDIF
  424.   ENDIF
  425.   f$=teil$+f$
  426.   RETURN FALSE
  427. ENDFUNC
  428. > FUNCTION wert(teil$)
  429.   LOCAL wert|
  430.   IF teil$=""
  431.     wert|=200
  432.   ELSE IF teil$="SIN"
  433.     wert|=202
  434.   ELSE IF teil$="COS"
  435.     wert|=203
  436.   ELSE IF teil$="TAN"
  437.     wert|=204
  438.   ELSE IF teil$="COT"
  439.     wert|=205
  440.   ELSE IF teil$="ASIN"
  441.     wert|=206
  442.   ELSE IF teil$="ACOS"
  443.     wert|=207
  444.   ELSE IF teil$="ATAN"
  445.     wert|=208
  446.   ELSE IF teil$="ACOT"
  447.     wert|=209
  448.   ELSE IF teil$="SINH"
  449.     wert|=210
  450.   ELSE IF teil$="COSH"
  451.     wert|=211
  452.   ELSE IF teil$="TANH"
  453.     wert|=212
  454.   ELSE IF teil$="COTH"
  455.     wert|=213
  456.   ELSE IF teil$="ASINH"
  457.     wert|=214
  458.   ELSE IF teil$="ACOSH"
  459.     wert|=215
  460.   ELSE IF teil$="ATANH"
  461.     wert|=216
  462.   ELSE IF teil$="ACOTH"
  463.     wert|=217
  464.   ELSE IF teil$="SQRT"
  465.     wert|=218
  466.   ELSE IF teil$="LN"
  467.     wert|=219
  468.   ELSE IF teil$="LOG"
  469.     wert|=220
  470.   ELSE IF teil$="ABS"
  471.     wert|=221
  472.   ELSE IF teil$="SGN"
  473.     wert|=222
  474.   ELSE IF teil$="EXP"
  475.     wert|=223
  476.   ENDIF
  477.   RETURN wert|
  478. ENDFUNC
  479. > FUNCTION oper(VAR f$,fp|)
  480.   ' diese Funktion erkennt Operatoren und schreibt den zum erkannten Operator
  481.   ' gehörigen Wert in f(i).
  482.   ' f$ wird immer um den erkannten Teil gekürzt.
  483.   ' Wird nichts erkannt, gibt die Funktion FALSE zurück.
  484.   LOCAL oper$,wert|
  485.   oper$=LEFT$(f$)
  486.   IF oper$="+"
  487.     wert|=250
  488.   ELSE IF oper$="-"
  489.     wert|=251
  490.   ELSE IF oper$="*"
  491.     wert|=252
  492.   ELSE IF oper$="/"
  493.     wert|=253
  494.   ELSE IF oper$="^"
  495.     wert|=254
  496.   ENDIF
  497.   IF wert|
  498.     f$=RIGHT$(f$,LEN(f$)-1) !bei erfolgreicher suche f$ kürzen
  499.     f|(fp|)=wert|
  500.     INC fp|
  501.     RETURN TRUE
  502.   ENDIF
  503.   RETURN FALSE
  504. ENDFUNC
  505. > FUNCTION klzu(VAR f$,fp|,kl&)
  506.   ' Diese Funktion erkennt schließende Klammern, und schreibt den
  507.   ' zugehörigen Wert in f(i).
  508.   ' f$ wird immer um den erkannten Teil gekürzt.
  509.   ' Wird nichts erkannt, gibt die Funktion FALSE zurück.
  510.   IF ASC(f$)=ASC(")")
  511.     REPEAT
  512.       f$=RIGHT$(f$,LEN(f$)-1)
  513.       f|(fp|)=201
  514.       INC fp|
  515.       DEC kl&
  516.     UNTIL ASC(f$)<>ASC(")")
  517.     RETURN TRUE
  518.   ENDIF
  519.   RETURN FALSE
  520. ENDFUNC
  521. '
  522. ' --- Funktionswerte errechnen, in fun_wert() speichern -----------------------
  523. > PROCEDURE rechne
  524.   ' diese Prozedur läßt alle Funktionswerte berechnen und schreibt sie
  525.   ' in fun_wert().
  526.   '
  527.   ' Globale Variablen:
  528.   ' x_min,x_max,y_min,y_max, x_aufl|,y_aufl|, fun_wert(),f|()
  529.   '
  530.   LOCAL xi|,yi|,x#,y#
  531.   t%=TIMER
  532.   '
  533.   IF neu.rechne!
  534.     ARRAYFILL fun_wert.err!(),FALSE
  535.     DEFMOUSE 2
  536.     y#=y_min#
  537.     FOR yi|=0 TO y_aufl|-1
  538.       x#=x_min#
  539.       FOR xi|=0 TO x_aufl|-1
  540.         zahl#(0)=x#
  541.         zahl#(1)=y#
  542.         zahl#(2)=-x#
  543.         zahl#(3)=-y#
  544.         fun_wert#(xi|,yi|)=@erg(x#,y#)
  545.         ADD x#,xstep#
  546.       NEXT xi|
  547.       ADD y#,ystep#
  548.     NEXT yi|
  549.     DEFMOUSE 0
  550.     neu.rechne!=FALSE
  551.   ENDIF
  552.   t.rech&=TIMER-t%
  553. RETURN
  554. > FUNCTION erg(x#,y#)
  555.   '
  556.   ' Diese Funktion berechnet den zu x,y gehörigen Funktionswert.
  557.   '
  558.   ' Wiederhole bis jeder Funktionsschritt abgearbeitet ist
  559.   '  Wenn eine Zahl ist
  560.   '   Schreibe sie in den Keller
  561.   '  Sonst
  562.   '    bei Klammer zu
  563.   '      Wiederhole, solange im Operantenkeller ein Operant ist
  564.   '        arbeite ihn mit den zugehörigen Zahlen ab
  565.   '      arbeite die zur Klammer zu gehörige Funktion ab
  566.   '    bei Funktionsende
  567.   '      bis zum ende abarbeiten
  568.   '    sonst
  569.   '      Wenn der letzte Operator eine höhere Priorität hat als der folgende
  570.   '      und wenn das letzte und das Folgende Operatoren sind (keine Funktion)
  571.   '        dann errechne das Ergebnis
  572.   '      kellere den Operator/die Funktion ab
  573.   '
  574.   ' in f|() steht die Funktion
  575.   ' Globale Variablen:
  576.   ' f|(),kn(),ko|()
  577.   '
  578.   LOCAL knz|,koz|,i|
  579.   '
  580.   knz|=1
  581.   koz|=1
  582.   FOR i|=0 TO fp|-1
  583.     IF f|(i|)<200                   !Zahl
  584.       '  keller
  585.       kn#(knz|)=zahl#(f|(i|))
  586.       INC knz|
  587.     ELSE                        !keine Zahl
  588.       IF f|(i|)=201             !Klammer zu
  589.         WHILE ko|(koz|-1)>=250  !bei +-*/^
  590.           kn#(knz|-2)=@rech(kn#(knz|-2),ko|(koz|-1),kn#(knz|-1))
  591.           DEC knz|
  592.           DEC koz|
  593.         WEND
  594.         kn#(knz|-1)=@fun(ko|(koz|-1),kn#(knz|-1)) !die zu ")" gehörende funktion
  595.         DEC koz|
  596.       ELSE IF f|(i|)=255        !Ende der Funktion
  597.         WHILE koz|>1
  598.           IF ko|(koz|-1)>=250
  599.             kn#(knz|-2)=@rech(kn#(knz|-2),ko|(koz|-1),kn#(knz|-1))
  600.             DEC knz|
  601.             DEC koz|
  602.           ELSE
  603.             kn#(knz|-1)=@fun(ko|(koz|-1),kn#(knz|-1))
  604.             DEC koz|
  605.           ENDIF
  606.         WEND
  607.         RETURN kn#(1)
  608.       ELSE                      ! +-*/^( oder eine Funktion
  609.         '  keller
  610.         WHILE ko|(koz|-1)>=f|(i|) AND ko|(koz|-1)>=250 AND f|(i|)>=250
  611.           kn#(knz|-2)=@rech(kn#(knz|-2),ko|(koz|-1),kn#(knz|-1))
  612.           DEC knz|
  613.           DEC koz|
  614.         WEND
  615.         ko|(koz|)=f|(i|)        !abkellern
  616.         INC koz|
  617.       ENDIF
  618.     ENDIF
  619.   NEXT i|
  620. ENDFUNC
  621. > FUNCTION rech(n1#,o|,n2#)
  622.   IF o|=250
  623.     RETURN n1#+n2#
  624.   ELSE IF o|=251
  625.     RETURN n1#-n2#
  626.   ELSE IF o|=252
  627.     RETURN n1#*n2#
  628.   ELSE IF o|=253
  629.     IF n2#<>0
  630.       RETURN n1#/n2#
  631.     ELSE
  632.       fun_wert.err!(xi|,yi|)=TRUE
  633.     ENDIF
  634.   ELSE IF o|=254
  635.     IF INT(n2#)=n2# OR n1#>0
  636.       RETURN n1#^n2#
  637.     ELSE
  638.       fun_wert.err!(xi|,yi|)=TRUE
  639.     ENDIF
  640.   ENDIF
  641.   RETURN 0
  642.   PRINT "fehler";o|
  643. ENDFUNC
  644. > FUNCTION fun(o|,n#)
  645.   IF o|=200
  646.     RETURN n#
  647.   ELSE IF o|=202        !sin
  648.     RETURN SIN(n#)
  649.   ELSE IF o|=203        !cos
  650.     RETURN COS(n#)
  651.   ELSE IF o|=204        !tan
  652.     RETURN TAN(n#)
  653.   ELSE IF o|=205        !cotan
  654.     d#=TAN(n#)
  655.     IF d#<>0
  656.       RETURN 1/d#
  657.     ELSE
  658.       fun_wert.err!(xi|,yi|)=TRUE
  659.     ENDIF
  660.   ELSE IF o|=206        !arcsin,asin
  661.     IF ABS(n#)<=1
  662.       RETURN ASIN(n#)
  663.     ELSE
  664.       fun_wert.err!(xi|,yi|)=TRUE
  665.     ENDIF
  666.   ELSE IF o|=207        !arccos,acos
  667.     IF ABS(n#)<=1
  668.       RETURN ACOS(n#)
  669.     ELSE
  670.       fun_wert.err!(xi|,yi|)=TRUE
  671.     ENDIF
  672.   ELSE IF o|=208        !arctan,atan
  673.     RETURN ATN(n#)
  674.   ELSE IF o|=209        !arccotan,acot (?)
  675.     IF n#
  676.       RETURN ATN(1/n#)
  677.     ELSE
  678.       fun_wert.err!(xi|,yi|)=TRUE
  679.     ENDIF
  680.   ELSE IF o|=210        !sinh
  681.     RETURN (EXP(n#)-EXP(-n#))/2
  682.   ELSE IF o|=211        !cosh
  683.     RETURN (EXP(n#)+EXP(-n#))/2
  684.   ELSE IF o|=212        !tanh
  685.     RETURN EXP(n#)-EXP(-n#)/(EXP(n#)+EXP(-n#))
  686.   ELSE IF o|=213        !coth
  687.     IF n#<>0
  688.       RETURN EXP(n#)+EXP(-n#)/(EXP(n#)-EXP(-n#))
  689.     ELSE
  690.       fun_wert.err!(xi|,yi|)=TRUE
  691.     ENDIF
  692.   ELSE IF o|=214        !asinh
  693.     RETURN LOG(n#+SQR(n#^2+1))
  694.   ELSE IF o|=215        !acosh
  695.     IF n#>=1
  696.       RETURN LOG(n#+SQR(n#^2-1))
  697.     ELSE
  698.       fun_wert.err!(xi|,yi|)=TRUE
  699.     ENDIF
  700.   ELSE IF o|=216        !atanh
  701.     IF ABS(n#)<1
  702.       RETURN LOG((1+n#)/(1-n#))/2
  703.     ELSE
  704.       fun_wert.err!(xi|,yi|)=TRUE
  705.     ENDIF
  706.   ELSE IF o|=217
  707.     IF ABS(n#)>1
  708.       RETURN LOG((n#+1)/(n#-1))/2
  709.     ELSE
  710.       fun_wert.err!(xi|,yi|)=TRUE
  711.     ENDIF
  712.   ELSE IF o|=218        !Quadratwurzel sqrt
  713.     IF n#>=0
  714.       RETURN SQR(n#)
  715.     ELSE
  716.       fun_wert.err!(xi|,yi|)=TRUE
  717.     ENDIF
  718.   ELSE IF o|=219        !nat. Log.
  719.     IF n#>0
  720.       RETURN LOG(n#)
  721.     ELSE
  722.       fun_wert.err!(xi|,yi|)=TRUE
  723.     ENDIF
  724.   ELSE IF o|=220        !10er Log.
  725.     IF n#>0
  726.       RETURN LOG10(n#)
  727.     ELSE
  728.       fun_wert.err!(xi|,yi|)=TRUE
  729.     ENDIF
  730.   ELSE IF o|=221        !Absolutwert
  731.     RETURN ABS(n#)
  732.   ELSE IF o|=222        !Vorzeichenfunktion
  733.     RETURN SGN(n#)
  734.   ELSE IF o|=223
  735.     RETURN EXP(n#)
  736.   ELSE
  737.     RETURN -@fun(o|-25,n#) !bei neg. vorzeichen
  738.   ENDIF
  739.   RETURN 0
  740.   PRINT "fehler";o|
  741. ENDFUNC
  742. > PROCEDURE keller
  743.   LOCAL i|
  744.   PRINT "ko ";koz|;": ";
  745.   FOR i|=1 TO koz|
  746.     PRINT ko|(i|)'
  747.   NEXT i|
  748.   PRINT
  749.   PRINT "kn ";knz|;": ";
  750.   FOR i|=1 TO knz|
  751.     PRINT kn#(i|)'
  752.   NEXT i|
  753.   PRINT
  754. RETURN
  755. '
  756. ' Betrachterstandpunkt:
  757. ' ges_abst - Abstand des Betrachters zum Ursprung = √(x_abst²+y_abst²+z_abst²)
  758. ' umz&, zuz& - Rotation des Betrachters um die z-Achse und zu der z-Achse
  759. '       daraus werden die folgenden Werte errechnet
  760. ' x_abst, y_abst, z_abst - Betrachterstandpunkt in den einzelnen Achsen
  761. '
  762. ' Darstellung:
  763. ' stauch - Stauchungsfaktor, damit die Funktion die Bildschirmbreite einnimmt
  764. ' zent_x& - dient dazu, die Funktion in der Bildschirmmitte darzustellen
  765. '
  766. ' --- Funktion darstellen -----------------------------------------------------
  767. > PROCEDURE proje.all
  768.   ' Die Prozedur proje.all stellt die in fun_wert() gespeicherten Funktionswerte
  769.   ' in bx&(),by&() auf Bildschirmbreite dar.
  770.   '   Anschließend wird der größte und der kleinste y-Wert gesucht. Mit Hilfe
  771.   ' dieser Werte wird die Funktion in y-Richtung zentriert, so daß z.B. bei
  772.   ' f(x,y)=10 die Funktion nicht "über" den Bildschirm gezeichnet wird.
  773.   ' Wenn die Funktion in y-Richtung angepaßt werden soll, wird mit Hilfe
  774.   ' des größten und des kleinsten y-Wertes ein Faktor errechnet, mit
  775.   ' dem die einzelnen Bildschirmwerte multipliziert werden, um nicht über den
  776.   ' Bereich des Bildschirms zu kommen.
  777.   '
  778.   ' Globale Variablen:
  779.   ' x_aufl|,y_aufl|, x_min,xstep,y_min,ystep, x_abst,y_abst,z_abst
  780.   ' zent_x&,zent_y&
  781.   ' @projezier(),@stauch()
  782.   '
  783.   LOCAL xi|,yi|,x#,y#,stauch_x#,stauch_y#,zent_x&
  784.   LOCAL bx1&,by1&,bx2&,by2&
  785.   LOCAL by_max&,by_min&,zent_y&
  786.   '
  787.   t%=TIMER
  788.   IF neu.projezier!
  789.     by_min&=9999
  790.     by_max&=-9999
  791.     stauch_x#=@stauch(zent_x&) !Stauch- und Zentrierwert errechnen
  792.     '
  793.     ' --- auf den Bildschirm --------
  794.     DEFMOUSE 2
  795.     y#=y_min#
  796.     FOR yi|=0 TO y_aufl|-1
  797.       x#=x_min#
  798.       FOR xi|=0 TO x_aufl|-1
  799.         IF fun_wert.err!(xi|,yi|)=FALSE
  800.           projezier(x#,y#,fun_wert#(xi|,yi|),bx&,by&)
  801.           bx&(xi|,yi|)=bx&
  802.           by&(xi|,yi|)=by&
  803.           by_max&=MAX(by&,by_max&)
  804.           by_min&=MIN(by&,by_min&)
  805.         ENDIF
  806.         ADD x#,xstep#
  807.       NEXT xi|
  808.       ADD y#,ystep#
  809.     NEXT yi|
  810.     ' --- in y_Richtung zentrieren und ggf. Stauchen --------
  811.     '
  812.     IF by_max&-by_min&>w_ymax&-w_ymin& AND stauch_y!
  813.       stauch_y#=(w_ymax&-w_ymin&)/(by_max&-by_min&)
  814.     ELSE
  815.       stauch_y#=1
  816.     ENDIF
  817.     zent_y&=stauch_y#*(by_max&+by_min&)/2-(w_ymax&+w_ymin&)/2
  818.     '
  819.     FOR yi|=0 TO y_aufl|-1
  820.       FOR xi|=0 TO x_aufl|-1
  821.         IF fun_wert.err!(xi|,yi|)=FALSE
  822.           IF stauch_y!
  823.             by&(xi|,yi|)=by&(xi|,yi|)*stauch_y#
  824.             bx&(xi|,yi|)=(bx&(xi|,yi|)-(w_xmax&+w_xmin#)/2)*stauch_y#+(w_xmax&+w_xmin&)/2
  825.           ENDIF
  826.           SUB by&(xi|,yi|),zent_y&
  827.         ENDIF
  828.       NEXT xi|
  829.     NEXT yi|
  830.     neu.projezier!=FALSE
  831.   ENDIF
  832.   t.proj&=TIMER-t%
  833.   DEFMOUSE 0
  834. RETURN
  835. > PROCEDURE projezier(x#,y#,z#,VAR bx&,by&)
  836.   ' Diese Funktion projeziert den Punkt P(x,y,z) auf die Bildschirmebene
  837.   ' in bx&,by&. x-,y-,z_abst geben den Abstand vom Ursprung an; stauch_x
  838.   ' ist ein Faktor, der dazu dient, die Bildbreite möglichst günstig auszu-
  839.   ' nutzen, zent_x& dient dazu, die Werte nicht zu weit links oder rechts
  840.   ' zu zeichnen.
  841.   ' sin/cos_umz/zuz sind die Sinus/Cosinuswerte, mit deren hilfe die Funktion
  842.   ' gedreht wird.
  843.   '
  844.   ' Global:
  845.   ' y_abst,x_abst,z_abst
  846.   ' cos_umz,sin_umz,sin_zuz,cos_zuz
  847.   ' zent_x&,stauch_x
  848.   '
  849.   LOCAL flucht#
  850.   '
  851.   ' ??? gehört zu x,y - oder + ???
  852.   flucht#=SQR((x_abst#+x#)^2+(y_abst#+y#)^2+(z_abst#+z#)^2)/stauch_x#
  853.   ' flucht wird auch noch in @stauch() berrechnet
  854.   '
  855.   bx&=zent_x&+(x#*cos_umz#-y#*sin_umz#)/flucht#
  856.   by&=(w_ymax&+w_ymin&)/2-(z#*sin_zuz#+(x#*sin_umz#+y#*cos_umz#)*cos_zuz#)/flucht#
  857. RETURN
  858. '
  859. > PROCEDURE koord_system
  860.   ' Diese Prozedur zeichnet das Koordinatensystem auf den Bildschrim.
  861.   ' klen gibt die Länge mit der die Achsen des Koordinatensystems gezeichnet
  862.   ' werden an.
  863.   '
  864.   ' Globale:
  865.   ' @projezier(),benötigt zent_x&,stauch_x
  866.   '
  867.   LOCAL klen#,bx&,by&,zent_x&,stauch_x#
  868.   '
  869.   stauch_x#=@stauch(zent_x&) !Stauch- und Zentrierwert errechnen
  870.   '
  871.   klen#=(x_max#+y_max#)/4
  872.   '
  873.   DEFLINE (&X0),1,0,1
  874.   DEFTEXT ,,,6
  875.   '
  876.   projezier(klen#,0,0,bx&,by&)
  877.   LINE zent_x&,(w_ymax&+w_ymin&)/2,bx&,by&
  878.   TEXT bx&,by&+8,"x"
  879.   '
  880.   projezier(0,klen#,0,bx&,by&)
  881.   LINE zent_x&,(w_ymax&+w_ymin&)/2,bx&,by&
  882.   TEXT bx&,by&+8,"y"
  883.   '
  884.   projezier(0,0,klen#,bx&,by&)
  885.   LINE zent_x&,(w_ymax&+w_ymin&)/2,bx&,by&
  886.   TEXT bx&-3,by&-2,"z"
  887.   '
  888.   DEFLINE 1,0,0,0
  889.   DEFTEXT ,,,13
  890. RETURN
  891. > FUNCTION stauch(VAR zent_x&)
  892.   ' Es wird ein Faktor errechnet, mit dem die Funktion auf die Bildschirmbreite
  893.   ' angepaßt wird.
  894.   ' Zusätzlich wird ein Wert errechnet, der die Funktion in der Bildmitte
  895.   ' platziert.
  896.   '
  897.   LOCAL flucht1#,flucht2#,flucht3#,flucht4#
  898.   LOCAL bild_x_min#,bild_x_max#,stauch_x#
  899.   stauch_x#=1
  900.   zent_x&=0
  901.   '
  902.   flucht1#=SQR((x_abst#+x_min#)^2+(y_abst#+y_min#)^2+(z_abst#-fun_wert#(0,0))^2)
  903.   flucht2#=SQR((x_abst#+x_max#)^2+(y_abst#+y_min#)^2+(z_abst#-fun_wert#(x_aufl|-1,0))^2)
  904.   flucht3#=SQR((x_abst#+x_min#)^2+(y_abst#+y_max#)^2+(z_abst#-fun_wert#(0,y_aufl|-1))^2)
  905.   flucht4#=SQR((x_abst#+x_max#)^2+(y_abst#+y_max#)^2+(z_abst#-fun_wert#(x_aufl|-1,y_aufl|-1))^2)
  906.   '
  907.   bild_x_min#=MIN((x_min#*cos_umz#-y_min#*sin_umz#)/flucht1#,(x_max#*cos_umz#-y_min#*sin_umz#)/flucht2#,(x_min#*cos_umz#-y_max#*sin_umz#)/flucht3#,(x_max#*cos_umz#-y_max#*sin_umz#)/flucht4#)
  908.   bild_x_max#=MAX((x_min#*cos_umz#-y_min#*sin_umz#)/flucht1#,(x_max#*cos_umz#-y_min#*sin_umz#)/flucht2#,(x_min#*cos_umz#-y_max#*sin_umz#)/flucht3#,(x_max#*cos_umz#-y_max#*sin_umz#)/flucht4#)   !**muß für drehungen evt noch mehr enthalten
  909.   '
  910.   stauch_x#=(w_xmax&-w_xmin&)/(bild_x_max#-bild_x_min#)
  911.   zent_x&=(w_xmax&+w_xmin&)/2-(bild_x_max#+bild_x_min#)/2*stauch_x#
  912.   RETURN stauch_x#
  913. ENDFUNC
  914. > PROCEDURE draw
  915.   DEFFILL 1,0,0
  916.   PBOX -1,18,640,400
  917.   '  PRINT AT(1,3);"Gerechnet: ";t.rech&/200
  918.   '  PRINT "Projeziert: ";t.proj&/200
  919.   IF beleuchtet! AND lich.rahmen!=FALSE
  920.     BOUNDARY 0
  921.   ELSE
  922.     BOUNDARY 1
  923.   ENDIF
  924.   IF verdeckt! OR beleuchtet!
  925.     IF neu.reihe!
  926.       reihenfolge(help#())
  927.     ENDIF
  928.     IF beleuchtet!
  929.       IF neu.beleuchte!
  930.         beleuchte(help#())
  931.       ENDIF
  932.       t%=TIMER
  933.       draw.beleuchtet
  934.     ELSE
  935.       t%=TIMER
  936.       DEFFILL 1,0,0
  937.       draw.verdeckt
  938.     ENDIF
  939.   ELSE
  940.     t%=TIMER
  941.     draw.draht
  942.   ENDIF
  943.   t.draw&=TIMER-t%
  944.   IF koord_system!
  945.     koord_system
  946.   ENDIF
  947.   '  PRINT "Abstand: ";t.entf&/200
  948.   '  PRINT "Licht: ";t.lich&/200
  949.   '  PRINT "Zeichnen: ";t.draw&/200
  950.   CLR t.draw&,t.entf&,t.lich&,t.proj&,t.rech&
  951. RETURN
  952. > PROCEDURE reihenfolge(VAR entf.punkt#())
  953.   LOCAL x_anf#,x_pos#,y_pos#,x|,nr&,nr_end&
  954.   ' Diese Prozedur ermittelt den Abstand (in x-y-Richtung) der einzelnen Felder
  955.   ' vom Betrachter in entf.punkt(). entf.order%() ist ein durchnummeriertes
  956.   ' Feld. Nachdem alle Abstände ermittlet wurden, wird entf.punkt() so sortiert,
  957.   ' daß die am weitesten entfernten Felder an erster Stelle stehen. Zudem
  958.   ' werden in gleicher Weise die Werte von entf.order%() getauscht, so daß
  959.   ' das Feld, das entf.order%(n) darstellt, als n-tes gezeichnet werden soll.
  960.   '
  961.   ' --- Berechnen der Entfernung vom Betrachter ----
  962.   t%=TIMER
  963.   IF neu.reihe!
  964.     x_anf#=x_min#+xstep#/2+x_abst#
  965.     y_pos#=y_min#+ystep#/2+y_abst#
  966.     x_pos#=x_anf#
  967.     nr_end&=(x_aufl|-1)*(y_aufl|-1)
  968.     REPEAT
  969.       entf.punkt#(nr&)=x_pos#^2+y_pos#^2
  970.       INC x|
  971.       ADD x_pos#,xstep#
  972.       IF x|=x_aufl|-1
  973.         ADD y_pos#,ystep#
  974.         x_pos#=x_anf#
  975.         x|=0
  976.       ENDIF
  977.       entf.order%(nr&)=nr&
  978.       INC nr&
  979.     UNTIL nr&=nr_end&
  980.     QSORT entf.punkt#(-),nr_end&,entf.order%()
  981.     neu.reihe!=FALSE
  982.   ENDIF
  983.   t.entf&=TIMER-t%
  984. RETURN
  985. > PROCEDURE beleuchte(VAR d#())
  986.   LOCAL xi|,yi|,lich_ges#,nr&,d_min#,d_max#
  987.   '   Im ersten Teil wird der Abstand der Flächen zur Lichtquelle bestimmt
  988.   ' und gespeichert, und es wird (wenn nötig) der Winkel, den die Fläche zur
  989.   ' Lichtquelle einnimmt gespeichert.
  990.   '   Wenn die Helligkeit auch nach der Entfernung bestimmt werden soll wird
  991.   ' im zweiten Teil wird jeder Entfernung ein Helligkeitswert zugewiesen.
  992.   ' Wenn auch der Winkel die Helligkeit bestimmt, wird der Entfernungswert
  993.   ' mit dem Winkelwert multipliziert, da die Helligkeitswerte dann natürlich
  994.   ' zu groß werden, ist die Wurzel des erhaltenen wertes die Helligkeit.
  995.   '   Je größer der Wert in hell|(), um so heller ist das entsprechende Feld.
  996.   '
  997.   ' d(): Abstand der Lichtquelle zum beleuchteten Feld
  998.   t%=TIMER
  999.   IF neu.beleuchte!
  1000.     ON ERR GOSUB lich.err
  1001.     ' --- Winkel und Abstand werden errechnet -----------------
  1002.     nr&=0
  1003.     d_min#=9999
  1004.     d_max#=-9999
  1005.     '    ARRAYFILL hell|(),1
  1006.     lich_ges#=lich_x#^2+lich_y#^2+lich_z#^2
  1007.     x_anf#=x_min#+xstep#/2
  1008.     y_pos#=y_min#+ystep#/2
  1009.     FOR yi|=0 TO y_aufl|-2
  1010.       x_pos#=x_anf#
  1011.       FOR xi|=0 TO x_aufl|-2
  1012.         IF fun_wert.err!(xi|,yi|)=FALSE AND fun_wert.err!(xi|+1,yi|)=FALSE AND fun_wert.err!(xi|,yi|+1)=FALSE
  1013.           ' d: (Länge der Strecke Lichtpunkt - Feldpunkt)^2
  1014.           d#(nr&)=(lich_x#-x_pos#)^2+(lich_y#-y_pos#)^2+(lich_z#-fun_wert#(xi|,yi|))^2
  1015.           d_min#=MIN(d#(nr&),d_min#)
  1016.           d_max#=MAX(d#(nr&),d_max#)
  1017.           '
  1018.           IF lich.winkel!
  1019.             ' der Normalenvektor der berechneten Fläche
  1020.             nx#=-(fun_wert#(xi|+1,yi|)-fun_wert#(xi|,yi|))/xstep#
  1021.             ny#=-(fun_wert#(xi|,yi|+1)-fun_wert#(xi|,yi|))/ystep#
  1022.             nz#=1
  1023.             ' cos: cos vom winkel zw. Normalen und Lichtpunkt-Feldpunkt-Vektor
  1024.             cos#=(lich_x#-x_pos#)*nx#+(lich_y#-y_pos#)*ny#+(lich_z#-fun_wert#(xi|,yi|))*nz#
  1025.             cos#=cos#/SQR(d#(nr&)*(nx#^2+ny#^2+nz#^2))
  1026.             '
  1027.             hell|(xi|,yi|)=ABS(cos#*lich.farbanz|) !stark beschienen - kl.hell|()
  1028.           ENDIF
  1029.         ENDIF
  1030.         ADD x_pos#,xstep#
  1031.         INC nr&
  1032.       NEXT xi|
  1033.       ADD y_pos#,ystep#
  1034.     NEXT yi|
  1035.     '
  1036.     IF lich.entfernung!
  1037.       ' --- zum Abstand gehörende Helligkeit wird errechnet --------
  1038.       nr&=0
  1039.       d_sumand#=-d_min#
  1040.       d_faktor#=lich.farbanz|/(d_max#-d_min#)
  1041.       FOR yi|=0 TO y_aufl|-2
  1042.         FOR xi|=0 TO x_aufl|-2
  1043.           ADD d#(nr&),d_sumand#
  1044.           IF lich.winkel!
  1045.             hell|(xi|,yi|)=SQR(hell|(xi|,yi|)*(lich.farbanz|-d_faktor#*d#(nr&)))
  1046.           ELSE
  1047.             hell|(xi|,yi|)=lich.farbanz|-d_faktor#*d#(nr&) !gr. d - kl. hell|()
  1048.           ENDIF
  1049.           INC nr&
  1050.         NEXT xi|
  1051.       NEXT yi|
  1052.     ENDIF
  1053.     neu.beleuchte!=FALSE
  1054.     ON ERROR
  1055.   ENDIF
  1056.   t.lich&=TIMER-t%
  1057. RETURN
  1058. > PROCEDURE lich.err
  1059.   ON ERROR GOSUB lich.err
  1060.   ALERT 1,"Fehler "+STR$(ERR)+"|ist aufgetreten!",1,"Weiter|Menü",d|
  1061.   IF d|=1
  1062.     RESUME NEXT
  1063.   ELSE
  1064.     RESUME menu
  1065.   ENDIF
  1066. RETURN
  1067. '
  1068. > PROCEDURE draw.draht
  1069.   LOCAL xi|,yi|
  1070.   ' Globale Variablen:
  1071.   ' x_aufl|,y_aufl|,bx&(),by&()
  1072.   '
  1073.   FOR yi|=0 TO y_aufl|-1
  1074.     FOR xi|=0 TO x_aufl|-1
  1075.       IF fun_wert.err!(xi|,yi|)=FALSE
  1076.         IF xi|
  1077.           IF fun_wert.err!(xi|-1,yi|)=FALSE
  1078.             LINE bx&(xi|-1,yi|),by&(xi|-1,yi|),bx&(xi|,yi|),by&(xi|,yi|)
  1079.           ENDIF
  1080.         ENDIF
  1081.         IF yi|
  1082.           IF fun_wert.err!(xi|,yi|-1)=FALSE
  1083.             LINE bx&(xi|,yi|-1),by&(xi|,yi|-1),bx&(xi|,yi|),by&(xi|,yi|)
  1084.           ENDIF
  1085.         ENDIF
  1086.       ENDIF
  1087.     NEXT xi|
  1088.   NEXT yi|
  1089. RETURN
  1090. > PROCEDURE draw.verdeckt
  1091.   LOCAL nr&,nr_end&,x|,y|
  1092.   ' Globale Variablen:
  1093.   ' x_aufl|,entf.order%()
  1094.   '
  1095.   nr_end&=(x_aufl|-1)*(y_aufl|-1)
  1096.   REPEAT
  1097.     x|=entf.order%(nr&) MOD (x_aufl|-1)
  1098.     y|=entf.order%(nr&) DIV (x_aufl|-1)
  1099.     IF fun_wert.err!(x|,y|)=FALSE
  1100.       IF fun_wert.err!(x|+1,y|)=FALSE
  1101.         IF fun_wert.err!(x|,y|+1)=FALSE
  1102.           IF fun_wert.err!(x|+1,y|+1)=FALSE
  1103.             polyfill(lich.farbanz|,x|,y|)
  1104.           ENDIF
  1105.         ENDIF
  1106.       ENDIF
  1107.     ENDIF
  1108.     INC nr&
  1109.   UNTIL nr&=nr_end&
  1110. RETURN
  1111. > PROCEDURE draw.beleuchtet
  1112.   LOCAL nr&,nr_end&,x|,y|
  1113.   ' Globale Variablen:
  1114.   ' x_aufl|,entf.order%()
  1115.   '
  1116.   nr_end&=(x_aufl|-1)*(y_aufl|-1)
  1117.   REPEAT
  1118.     x|=entf.order%(nr&) MOD (x_aufl|-1)
  1119.     y|=entf.order%(nr&) DIV (x_aufl|-1)
  1120.     IF fun_wert.err!(x|,y|)=FALSE
  1121.       IF fun_wert.err!(x|+1,y|)=FALSE
  1122.         IF fun_wert.err!(x|,y|+1)=FALSE
  1123.           IF fun_wert.err!(x|+1,y|+1)=FALSE
  1124.             polyfill(hell|(x|,y|),x|,y|)
  1125.           ENDIF
  1126.         ENDIF
  1127.       ENDIF
  1128.     ENDIF
  1129.     INC nr&
  1130.   UNTIL nr&=nr_end&
  1131. RETURN
  1132. > PROCEDURE polyfill(color|,xi|,yi|)
  1133.   color|=lich.farbanz|-color|
  1134.   IF color|<1
  1135.     DEFFILL 1,0,0
  1136.   ELSE
  1137.     DEFFILL 1,2,MIN(color|,8)
  1138.   ENDIF
  1139.   x&(0)=bx&(xi|+1,yi|+1)
  1140.   x&(1)=bx&(xi|,yi|+1)
  1141.   x&(2)=bx&(xi|,yi|)
  1142.   x&(3)=bx&(xi|+1,yi|)
  1143.   x&(4)=bx&(xi|+1,yi|+1)
  1144.   '  x&(5)=bx&(xi|,yi|)
  1145.   y&(0)=by&(xi|+1,yi|+1)
  1146.   y&(1)=by&(xi|,yi|+1)
  1147.   y&(2)=by&(xi|,yi|)
  1148.   y&(3)=by&(xi|+1,yi|)
  1149.   y&(4)=by&(xi|+1,yi|+1)
  1150.   '  y&(5)=by&(xi|,yi|)
  1151.   POLYFILL 5,x&(),y&()
  1152. RETURN
  1153. '
  1154. ' Bildschirm:
  1155. ' z-Achse
  1156. '   ∧
  1157. '   |
  1158. '   | ¬ y-Achse
  1159. '   |/
  1160. '   +------>
  1161. '         x-Achse
  1162. '
  1163. > PROCEDURE funktion.eingabe
  1164.   LOCAL d&,rueck&
  1165.   @text.set(0,0,0,"f(x,y)=")
  1166.   @edit.set(0,0,0,f$)
  1167.   wind.name$=" Funktion eingeben "
  1168.   '
  1169.   REPEAT
  1170.     eingabe(2,edit.x&(),edit.y&(),edit$())
  1171.     f$=UPPER$(edit$(0))
  1172.     rueck&=@formatiere_f(f$,f|())
  1173.     IF rueck&<>-1
  1174.       ALERT 1,"Fehler an Stelle "+STR$(rueck&),1,"Weiter",d&
  1175.     ENDIF
  1176.   UNTIL rueck&=-1
  1177.   neu.rechne!=TRUE
  1178.   neu.projezier!=TRUE
  1179.   neu.beleuchte!=TRUE
  1180. RETURN
  1181. > PROCEDURE rotation
  1182.   @text.set(0,0,0,"Rotation um die z-Achse:")
  1183.   @edit.set(0,0,0,STR$(umz&))
  1184.   @text.set(1,0,1,"Neigung zur z-Achse    :")
  1185.   @edit.set(1,0,1,STR$(zuz&))
  1186.   wind.name$=" Rotationen "
  1187.   '
  1188.   eingabe(2,edit.x&(),edit.y&(),edit$())
  1189.   '
  1190.   umz&=VAL(edit$(0))
  1191.   zuz&=VAL(edit$(1))
  1192.   '
  1193.   cos_umz#=COS(umz&/360*2*PI)
  1194.   sin_umz#=SIN(umz&/360*2*PI)
  1195.   cos_zuz#=COS(zuz&/360*2*PI)
  1196.   sin_zuz#=SIN(zuz&/360*2*PI)
  1197.   x_abst#=ges_abst#*sin_umz#*sin_zuz#
  1198.   y_abst#=ges_abst#*cos_umz#*sin_zuz#
  1199.   z_abst#=ges_abst#*cos_zuz#
  1200.   neu.reihe!=TRUE
  1201.   neu.projezier!=TRUE
  1202. RETURN
  1203. > PROCEDURE entfernung
  1204.   @text.set(0,0,0,"Entfernung vom Ursprung:")
  1205.   @edit.set(0,0,0,STR$(ges_abst#))
  1206.   wind.name$=" Entfernung "
  1207.   '
  1208.   eingabe(1,edit.x&(),edit.y&(),edit$())
  1209.   '
  1210.   ges_abst#=VAL(edit$(0))
  1211.   x_abst#=ges_abst#*sin_umz#*sin_zuz#
  1212.   y_abst#=ges_abst#*cos_umz#*sin_zuz#
  1213.   z_abst#=ges_abst#*cos_zuz#
  1214.   neu.reihe!=TRUE
  1215.   neu.projezier!=TRUE
  1216. RETURN
  1217. > PROCEDURE wertebereich
  1218.   LOCAL ok!
  1219.   @text.set(0,0,0,"x-Minimum:")
  1220.   @edit.set(0,0,0,STR$(x_min#))
  1221.   @text.set(1,0,1,"x-Maximum:")
  1222.   @edit.set(1,0,1,STR$(x_max#))
  1223.   @text.set(2,0,2,"y-Minimum:")
  1224.   @edit.set(2,0,2,STR$(y_min#))
  1225.   @text.set(3,0,3,"y-Maximum:")
  1226.   @edit.set(3,0,3,STR$(y_max#))
  1227.   wind.name$=" Wertebereich "
  1228.   '
  1229.   REPEAT
  1230.     eingabe(3,edit.x&(),edit.y&(),edit$())
  1231.     x_min#=VAL(edit$(0))
  1232.     x_max#=VAL(edit$(1))
  1233.     y_min#=VAL(edit$(2))
  1234.     y_max#=VAL(edit$(3))
  1235.     ok!=x_min#<x_max# AND y_min#<y_max#
  1236.     IF ok!=0
  1237.       ALERT 1,"Falscher Wertebereich!",1,"Weiter",d&
  1238.     ENDIF
  1239.   UNTIL ok!
  1240.   xstep#=(x_max#-x_min#)/(x_aufl|-1)
  1241.   ystep#=(y_max#-y_min#)/(y_aufl|-1)
  1242.   neu.rechne!=TRUE
  1243.   neu.projezier!=TRUE
  1244.   neu.beleuchte!=TRUE
  1245. RETURN
  1246. > PROCEDURE aufloesung
  1247.   @text.set(0,0,0,"Auflösung in x-Richtung:")
  1248.   @edit.set(0,0,0,STR$(x_aufl|))
  1249.   @text.set(1,0,1,"             y-Richtung:")
  1250.   @edit.set(1,0,1,STR$(y_aufl|))
  1251.   wind.name$=" Auflösung "
  1252.   '
  1253.   eingabe(1,edit.x&(),edit.y&(),edit$())
  1254.   x_aufl|=MAX(MIN(VAL(edit$(0)),100),2)   ! 2 bis 100
  1255.   y_aufl|=MAX(MIN(VAL(edit$(1)),100),2)
  1256.   xstep#=(x_max#-x_min#)/(x_aufl|-1)
  1257.   ystep#=(y_max#-y_min#)/(y_aufl|-1)
  1258.   neu.rechne!=TRUE
  1259.   neu.reihe!=TRUE
  1260.   neu.projezier!=TRUE
  1261.   neu.beleuchte!=TRUE
  1262. RETURN
  1263. > PROCEDURE beleuchtung
  1264.   @text.set(0,0,0,"Position der Beleuchtungsquelle:")
  1265.   @text.set(1,0,1,"x-Richtung:")
  1266.   @edit.set(0,0,1,STR$(lich_x#))
  1267.   @text.set(2,0,2,"y-Richtung:")
  1268.   @edit.set(1,0,2,STR$(lich_y#))
  1269.   @text.set(3,0,3,"z-Richtung:")
  1270.   @edit.set(2,0,3,STR$(lich_z#))
  1271.   wind.name$="Beleuchtung"
  1272.   '
  1273.   eingabe(2,edit.x&(),edit.y&(),edit$())
  1274.   lich_x#=VAL(edit$(0))
  1275.   lich_y#=VAL(edit$(1))
  1276.   lich_z#=VAL(edit$(2))
  1277.   neu.beleuchte!=TRUE
  1278. RETURN
  1279. > PROCEDURE werte_ausgeben(luecken!)
  1280.   LOCAL xi|,yi|,i&,n&,x|,y|
  1281.   LOCAL exit!
  1282.   '
  1283.   DEFFILL 0,0,0
  1284.   PBOX 0,20,640,400
  1285.   IF neu.rechne!=FALSE
  1286.     FOR yi|=0 TO y_aufl|-1
  1287.       FOR xi|=0 TO x_aufl|-1
  1288.         IF (fun_wert.err!(xi|,yi|) XOR NOT luecken!)
  1289.           x|=(i& MOD 15)+1
  1290.           y|=(i& DIV 15)*26
  1291.           IF luecken!
  1292.             text.set(x|,y|,x|,STR$(x_min#+xi|*xstep#)+", "+STR$(y_min#+yi|*ystep#))
  1293.           ELSE
  1294.             text.set(x|,y|,x|,"("+STR$(x_min#+xi|*xstep#)+","+STR$(y_min#+yi|*ystep#)+","+STR$(fun_wert#(xi|,yi|))+")")
  1295.           ENDIF
  1296.           INC i&
  1297.           INC n&
  1298.           IF i&>=45
  1299.             IF luecken!
  1300.               text.set(0,0,0,"Auf Definitionslücken wurden an folgenden Stellen zugegriffen:")
  1301.             ELSE
  1302.               text.set(0,0,0,"Funktionspunkte:")
  1303.             ENDIF
  1304.             exit!=INP(2)=27
  1305.             DEFFILL 0,0,0
  1306.             PBOX 0,20,640,400
  1307.             i&=0
  1308.           ENDIF
  1309.         ENDIF
  1310.         EXIT IF exit!
  1311.       NEXT xi|
  1312.       EXIT IF exit!
  1313.     NEXT yi|
  1314.   ENDIF
  1315.   IF i& AND neu.rechne!=FALSE
  1316.     IF luecken!
  1317.       text.set(0,0,0,"Auf Definitionslücken wurden an folgenden Stellen zugegriffen:")
  1318.       text.set(0,16,16,STR$(n&)+" nicht def. Stellen ausgegeben.")
  1319.     ELSE
  1320.       text.set(0,0,0,"Funktionspunkte:")
  1321.       text.set(0,16,16,STR$(n&)+" Funktionswerte ausgegeben.")
  1322.     ENDIF
  1323.     ~INP(2)
  1324.   ELSE
  1325.     IF luecken!
  1326.       text.set(0,0,0,"Es wurde nicht auf undefinierte Stellen zugegriffen!")
  1327.     ELSE
  1328.       text.set(0,0,0,"Funktionswerte noch nicht errechnet!")
  1329.     ENDIF
  1330.     ~INP(2)
  1331.   ENDIF
  1332.   DEFFILL 0,0,0
  1333.   PBOX 0,20,640,400
  1334. RETURN
  1335. '
  1336. > PROCEDURE text.set(n|,x&,y&,text$)
  1337.   text.x&(n|)=x&*8+16
  1338.   text.y&(n|)=y&*16+38
  1339.   TEXT text.x&(n|),text.y&(n|),text$
  1340.   text$(n|)=text$
  1341. RETURN
  1342. > PROCEDURE edit.set(n|,x&,y&,edit$)
  1343.   edit.x&(n|)=LEN(text$(y&))*8+16
  1344.   edit.y&(n|)=y&*16+38
  1345.   TEXT edit.x&(n|),edit.y&(n|),edit$
  1346.   edit$(n|)=edit$
  1347. RETURN
  1348. '
  1349. > PROCEDURE eingabe(n|,VAR edit.x&(),edit.y&(),edit$())
  1350.   '  h&=WIND_CREATE(&X1011,0,0,0,0)
  1351.   ' ~wind_set(
  1352.   '  ~WIND_OPEN(h&,100,19,200,100)
  1353.   '
  1354.   edit(n|,edit.x&(),edit.y&(),edit$())
  1355.   '
  1356.   '  ~WIND_CLOSE(h&)
  1357.   '  ~WIND_DELETE(h&)
  1358. RETURN
  1359. > PROCEDURE edit(n|,VAR edit.x&(),edit.y&(),edit$())
  1360.   ' Die Prozedur ermöglicht die Eingabe bzw. das Editieren von n Strings,
  1361.   ' in edit$() stehen. Die Bildschirmpositionen der einzelnen Strings stehen
  1362.   ' in edit.x&() und edit.y&().
  1363.   ' Interrupts der Tastatur und Menü/Fenster werden abgefragt.
  1364.   ' evt sollte i und cr auch übergeben werden
  1365.   '
  1366.   LOCAL undo$,key%,d&,asc|,cr|,i|,evnts&
  1367.   i|=0
  1368.   undo$=edit$(i|)
  1369.   cr|=LEN(edit$(i|))
  1370.   REPEAT
  1371.     cursor(edit.x&(i|)+cr|*8,edit.y&(i|),TRUE)
  1372.     '    evnts&=EVNT_MULTI(&X10001,0,0,0,0,1,0,0,0,0,0,0,0,0,0,0,mes&,key&,d&,d&,d&,d&)
  1373.     evnts&=1
  1374.     key%=GEMDOS(7)
  1375.     cursor(edit.x&(i|)+cr|*8,edit.y&(i|),FALSE)
  1376.     IF evnts&=1                 !Tastatur
  1377.       asc|=key% MOD 256
  1378.       scan|=(key%/65536) MOD 256
  1379.       SELECT scan|
  1380.       CASE 75
  1381.         IF cr|                       !<-
  1382.           DEC cr|
  1383.         ENDIF
  1384.       CASE 77
  1385.         IF cr|<LEN(edit$(i|))   !->
  1386.           INC cr|
  1387.         ENDIF
  1388.       CASE 14
  1389.         IF cr|                  !Backspace
  1390.           edit$(i|)=LEFT$(edit$(i|),cr|-1)+RIGHT$(edit$(i|),LEN(edit$(i|))-cr|)
  1391.           DEC cr|
  1392.         ENDIF
  1393.       CASE 83
  1394.         IF cr|<LEN(edit$(i|))   !Delete
  1395.           edit$(i|)=LEFT$(edit$(i|),cr|)+RIGHT$(edit$(i|),LEN(edit$(i|))-cr|-1)
  1396.         ENDIF
  1397.       CASE 97
  1398.         IF LEN(undo$)
  1399.           edit$(i|)=undo$
  1400.           cr|=LEN(edit$(i|))
  1401.         ENDIF
  1402.       CASE 72
  1403.         IF i|                   !v
  1404.           DEC i|
  1405.           undo$=edit$(i|)
  1406.           cr|=LEN(edit$(i|))
  1407.         ENDIF
  1408.       CASE 80
  1409.         IF i|<n|                !∧
  1410.           INC i|
  1411.           undo$=edit$(i|)
  1412.           cr|=LEN(edit$(i|))
  1413.         ENDIF
  1414.       DEFAULT
  1415.         IF asc|>31 AND LEN(edit$(i|))<255
  1416.           edit$(i|)=LEFT$(edit$(i|),cr|)+CHR$(asc|)+RIGHT$(edit$(i|),LEN(edit$(i|))-cr|)
  1417.           INC cr|
  1418.         ENDIF
  1419.       ENDSELECT
  1420.       TEXT edit.x&(i|),edit.y&(i|),edit$(i|)+"   "
  1421.     ELSE IF evnts&=16 !Message
  1422.     ENDIF
  1423.   UNTIL asc|=13 OR asc|=27
  1424. RETURN
  1425. > PROCEDURE cursor(x&,y&,setzen!)
  1426.   BOUNDARY 0
  1427.   GRAPHMODE 3
  1428.   DEFFILL 1,1,1
  1429.   PBOX x&,y&+2,x&+7,y&-13
  1430.   GRAPHMODE 1
  1431.   BOUNDARY 1
  1432. RETURN
  1433.